home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 January / CHIP Turkiye Ocak 1997.iso / program / sound / amod30 / list.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-07  |  8KB  |  368 lines
  1. unit list;
  2. interface
  3. uses crt,dos;
  4. const
  5.   maxline = 250;
  6.   t_none = 0;
  7.   t_mod = 1;
  8.   t_zip = 2;
  9.   t_dir = 3;
  10.   t_drive = 4;
  11.  
  12. type
  13. t_memarray = array[0..8000] of byte;
  14. t_line = record
  15.            s : array[0..2] of string[20];
  16.            t : integer;
  17.            tagged : boolean;
  18.          end;  
  19. t_linea = array[0..maxline] of t_line;
  20. p_linea = ^t_linea;
  21. t_list = object
  22.            x1,y1,x2,y2 : integer;
  23.            c1x,c2x,c3x : integer;
  24.            size,len : integer;
  25.            curline,startline : integer;
  26.            lines : p_linea;
  27.            tilt : t_line;
  28.            numtagged : integer;
  29.            procedure insline(s,s2,s3 : string;t : integer);
  30.            procedure delline;
  31.            procedure delete;
  32.            procedure init(maxline,minx,miny,maxx,maxy : integer;pic : pointer);
  33.            procedure done;
  34.            procedure draw;
  35.            procedure drawline(cline : integer);
  36.            procedure upline;
  37.            procedure downline;
  38.            procedure uppage;
  39.            procedure downpage;
  40.            procedure goend;
  41.            procedure gohome;
  42.            procedure gotokey(key : char);
  43.            procedure tagline;
  44.            procedure strswap(s1,s2 : integer);
  45.            function compare(a : integer):integer;
  46.            procedure sort(top,bottom : integer);
  47.            procedure qsort;
  48.          end;
  49.  
  50.  
  51. implementation
  52. var
  53. piccy : ^t_memarray;
  54.  
  55. procedure hiline(x,y,xl,c : integer); assembler;
  56. asm
  57.   dec  y
  58.   push ds
  59.   mov  ds,word ptr piccy+2
  60.   mov  ax,160
  61.   mul  y
  62.   add  ax,x
  63.   add  ax,x
  64.   mov  di,ax
  65.   mov  si,ax
  66.   mov  ax,0b800h
  67.   mov  es,ax
  68.   mov  cx,xl
  69.   mov  bx,c
  70. @@1:
  71.   mov  al,[si+1]
  72.   and  al,15
  73.   or   al,16
  74.   mov  es:[di+1],al
  75.   add  di,2
  76.   add  si,2
  77.   loop @@1
  78.   pop  ds
  79. end;
  80.  
  81. procedure orgline(x,y,xl : integer);
  82. var
  83. o : word;
  84. begin
  85.   o := (y-1)*160+x*2;
  86.   move(piccy^[o],mem[$b800:o],xl*2);
  87. end;
  88.  
  89. procedure fastwrite(x,y : word;s : string);
  90. begin
  91. {l := byte(s[0]);
  92. if l = 0 then exit;
  93. for n := 1 to l do mem[$b800:(y-1)*160+(x-1)*2+n*2-2] := byte(s[n]);}
  94. asm
  95.     push ds
  96.     mov  ax,ss
  97.     mov  ds,ax
  98.     mov  ax,0b800h
  99.     mov  es,ax
  100.     lea  si,s
  101.     lodsb
  102.     cmp  al,0
  103.     jne  @@2
  104.     jmp  @@end
  105. @@2:
  106.     mov  cl,al
  107.     xor  ch,ch
  108.     mov  di,y
  109.     dec  di
  110.     dec  x
  111.     mov  ax,160
  112.     mul  di
  113.     mov  di,ax
  114.     add  di,x
  115.     add  di,x
  116. @@1:
  117.     movsb
  118.     inc  di
  119.     loop @@1
  120. @@end:
  121.     pop  ds
  122. end;
  123. end;
  124.  
  125. procedure t_list.init(maxline,minx,miny,maxx,maxy : integer;pic : pointer);
  126. begin
  127.   piccy := pic;
  128.   size := maxline;
  129.   len := 0;
  130.   curline := 0;
  131.   startline := 1;
  132.   x1 := minx;
  133.   y1 := miny;
  134.   y2 := maxy;
  135.   x2 := maxx;
  136.   c1x := 1;
  137.   c2x := 20;
  138.   c3x := 40;
  139.   numtagged := 0;
  140.   getmem(lines,sizeof(t_line)*size);
  141. end;
  142.  
  143. procedure t_list.done;
  144. begin
  145.   freemem(lines,sizeof(t_line)*size);
  146. end;
  147.  
  148. procedure t_list.delete;
  149. begin
  150.   startline := 1;
  151.   curline := 1;
  152.   len := 0;
  153. end;
  154.  
  155. procedure t_list.delline;
  156. begin
  157.   if len > 0 then dec(len);
  158.   if curline > len then curline := len;
  159.   if startline > curline then startline := curline;
  160. end;
  161.  
  162. procedure t_list.insline(s,s2,s3 : string;t : integer);
  163. begin
  164.   if len >= size then exit;
  165.   inc(len);
  166.   lines^[len].s[0] := s;
  167.   lines^[len].s[1] := s2;
  168.   lines^[len].s[2] := s3;
  169.   lines^[len].t := t;
  170.   lines^[len].tagged := false;
  171.   if curline = 0  then curline := 1;
  172. end;
  173.  
  174. procedure t_list.upline;
  175. begin
  176.   if curline > 1 then dec(curline);
  177.   if curline < startline then begin
  178.     dec(startline);
  179.     draw;
  180.   end
  181.   else begin
  182.     drawline(curline+1);
  183.     drawline(curline);
  184.   end;
  185. end;
  186.  
  187. procedure t_list.downline;
  188. begin
  189.   if curline < len then inc(curline);
  190.   if curline > startline+y2-y1 then begin
  191.     inc(startline);
  192.     draw;
  193.   end
  194.   else begin
  195.     drawline(curline-1);
  196.     drawline(curline);
  197.   end;
  198. end;
  199.  
  200. procedure t_list.uppage;
  201. begin
  202.   if curline > startline then begin
  203.     curline := startline;
  204.   end
  205.   else begin
  206.     if curline > (y2-y1) then begin
  207.       dec(curline,y2-y1);
  208.       startline := curline;
  209.     end
  210.     else begin
  211.       curline := 1;
  212.       startline := 1;
  213.     end;
  214.   end;
  215.   draw;
  216. end;
  217.  
  218. procedure t_list.downpage;
  219. begin
  220.   if curline < startline+y2-y1 then begin
  221.     curline := startline+y2-y1;
  222.     if curline > len then curline := len;
  223.   end
  224.   else begin
  225.     inc(curline,y2-y1);
  226.     if curline > len then curline := len;
  227.     startline := curline-y2+y1;
  228.   end;
  229.   draw;
  230. end;
  231.  
  232. procedure t_list.goend;
  233. begin
  234.   curline := len;
  235.   if curline > y2-y1 then startline := curline-y2+y1
  236.   else startline := 1;
  237.   draw;
  238. end;
  239.  
  240. procedure t_list.gohome;
  241. begin
  242.   curline := 1;
  243.   startline := 1;
  244.   draw;
  245. end;
  246.  
  247. procedure t_list.gotokey(key : char);
  248. var
  249. n,i : integer;
  250. sline,dline : integer;
  251. begin
  252.   dline := 1;
  253.   sline := curline;
  254.   while (dline < len) and (lines^[dline].s[0][1] < key) do inc(dline);
  255.   if dline > curline then
  256.     for i := dline-1 downto sline do downline
  257.   else if dline < curline then
  258.     for i := dline+1 to sline do upline;
  259.   draw;
  260. end;
  261.  
  262. procedure t_list.tagline;
  263. begin
  264.   if lines^[curline].tagged then begin
  265.     lines^[curline].tagged := false;
  266.     dec(numtagged);
  267.   end
  268.   else begin
  269.     lines^[curline].tagged := true;
  270.     inc(numtagged);
  271.   end;
  272.   drawline(curline);
  273. end;
  274.  
  275. procedure t_list.draw;
  276. var
  277. n,cline : integer;
  278. wmin,wmax : integer;
  279. begin
  280.   for n := 1 to y2-y1+1 do begin
  281.     cline := startline+n-1;
  282.     if cline <= len then begin
  283.       if cline=curline then begin
  284.         orgline(x1-1,n+y1-1,50);
  285.         hiline(x1-1,n+y1-1,12,16);
  286.       end
  287.       else orgline(x1-1,n+y1-1,50);
  288.       fastwrite(x1,n+y1-1,lines^[cline].s[0]);
  289.       fastwrite(c2x+x1-1,n+y1-1,lines^[cline].s[1]);
  290.       fastwrite(c3x+x1-1,n+y1-1,lines^[cline].s[2]);
  291.     end;
  292.   end;
  293. end;
  294.  
  295. procedure t_list.drawline(cline : integer);
  296. var
  297. n : integer;
  298. wmin,wmax : integer;
  299. begin
  300.   n := cline-startline+1;
  301.   if (n > 0) and (n <= y2-y1+1) then if cline <= len then begin
  302.     if cline=curline then hiline(x1-1,n+y1-1,12,16)
  303.     else orgline(x1-1,n+y1-1,50);
  304.     fastwrite(x1,n+y1-1,lines^[cline].s[0]);
  305.     fastwrite(c2x+x1-1,n+y1-1,lines^[cline].s[1]);
  306.     fastwrite(c3x+x1-1,n+y1-1,lines^[cline].s[2]);
  307.   end;
  308. end;
  309.  
  310.  
  311. procedure t_list.strswap(s1,s2 :integer);
  312. var
  313. t : t_line;
  314. begin
  315.   t := lines^[s1];
  316.   lines^[s1] := lines^[s2];
  317.   lines^[s2] := t;
  318. end;
  319.  
  320. function t_list.compare(a : integer):integer;
  321. var
  322. s : string;
  323. t1,t2 : integer;
  324. begin
  325.   t1 := lines^[a].t;
  326.   t2 := tilt.t;
  327.   {if t1 = t_zip then t1 := t_mod;
  328.   if t2 = t_zip then t2 := t_mod;}
  329.   if t1 < t2 then compare := -1
  330.   else if t1 > t2 then compare := 1
  331.   else if lines^[a].s[0] < tilt.s[0] then compare := -1
  332.   else if lines^[a].s[0] > tilt.s[0] then compare := 1
  333.   else compare := 0;
  334. end;
  335.  
  336. procedure t_list.sort(top,bottom : integer);
  337. var
  338. i,j : integer;
  339. x : string[20];
  340. begin
  341.   i := top;
  342.   j := bottom;
  343.   x := lines^[(top+bottom) div 2].s[0];
  344.   tilt.s[0] := x;
  345.   tilt.t := lines^[(top+bottom) div 2].t;
  346.   repeat
  347.     while {lines^[i].s[0] < x]} compare(i)=-1 do inc(i);
  348.     while {(x < lines^[j].s[0])} compare(j)=1 do dec(j);
  349.     if i < j then begin
  350.       strswap(i,j);
  351.     end;
  352.     if i <= j then begin
  353.       inc(i);
  354.       dec(j);
  355.     end;
  356.   until i > j;
  357.   if top < j then sort(top,j);
  358.   if i < bottom then sort(i,bottom);
  359. end;
  360.  
  361. procedure t_list.qsort;
  362. begin
  363.   sort(1,len);
  364. end;
  365.  
  366. end.
  367.  
  368.